Network PC/Network PC.iso/windows 95 utilities/programming tools/extended pagecontrol/sample1.pas

Pascal/Delphi Source File | 1997-04-19 | 9KB | 325 lines

unit Sample1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, StdCtrls, Buttons, ExtCtrls, CommCtrl, ExtPage;

type
  TForm1 = class(TForm)
    ExtPageControl1: TExtPageControl;
    Page1: TTabSheet;
    Page2: TTabSheet;
    Page3: TTabSheet;
    Edit1: TEdit;
    PanelInfo: TPanel;
    MemoInfo: TMemo;
    BitBtnGo: TBitBtn;
    TabsPosition: TRadioGroup;
    GroupBox1: TGroupBox;
    ButtonColorForm: TButton;
    ButtonColorATab: TButton;
    ButtonColorITab: TButton;
    ButtonColorSheet: TButton;
    GroupBox2: TGroupBox;
    ButtonFontATab: TButton;
    ButtonFontITab: TButton;
    GroupBoxHints: TGroupBox;
    CheckBoxTabHints: TCheckBox;
    GroupBoxWordWrap: TGroupBox;
    CheckBoxWordWrap: TCheckBox;
    GroupBoxDisTab: TGroupBox;
    CheckBoxDisableTab: TCheckBox;
    GroupBoxOwnerDraw: TGroupBox;
    CheckBoxColorTabs: TCheckBox;
    CheckBoxColorPages: TCheckBox;
    GlyphsPosition: TRadioGroup;
    RadioGroupTabStyle: TRadioGroup;
    ExtTabControl1: TExtTabControl;
    CheckBoxDisableTab2: TCheckBox;
    ExtTabControl2: TExtTabControl;
    PanelTabControl2: TPanel;
    LabelTabControl1: TLabel;
    LabelTabControl2: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure BitBtnGoClick(Sender: TObject);
    procedure TabsPositionClick(Sender: TObject);
    procedure ButtonColorFormClick(Sender: TObject);
    procedure ButtonColorATabClick(Sender: TObject);
    procedure ButtonColorITabClick(Sender: TObject);
    procedure ButtonColorSheetClick(Sender: TObject);
    procedure ButtonFontATabClick(Sender: TObject);
    procedure ButtonFontITabClick(Sender: TObject);
    procedure CheckBoxTabHintsClick(Sender: TObject);
    procedure CheckBoxWordWrapClick(Sender: TObject);
    procedure CheckBoxDisableTabClick(Sender: TObject);
    procedure CheckBoxColorTabsClick(Sender: TObject);
    procedure CheckBoxColorPagesClick(Sender: TObject);
    procedure GlyphsPositionClick(Sender: TObject);
    procedure RadioGroupTabStyleClick(Sender: TObject);
    procedure CheckBoxDisableTab2Click(Sender: TObject);
    procedure ExtTabControl2DrawTab(Control: TWinControl; Index: Integer;
      ActiveTab: Boolean; const RectFg, RectBg: TRect;
      State: TOwnerDrawState);
    procedure ExtTabControl2Change(Sender: TObject);
  private
    procedure DrawColoredTab(Control: TWinControl; Index: Integer;
      ActiveTab: Boolean; const RectFg, RectBg: TRect; State: TOwnerDrawState);
    procedure ChangeColored(Sender: TObject);
    function ColorFromIndex(Index: Integer): TColor;
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses ShellApi;

// creation of the form
procedure TForm1.FormCreate(Sender: TObject);
begin
  TabsPosition.Enabled:= ExtPageControl1.IsNewComCtl;
  ExtTabControl2.TabIndex:= -1;
end;

procedure TForm1.BitBtnGoClick(Sender: TObject);
begin
  ShellExecute(Application.Handle, 'open',
               'http://ourworld.compuserve.com/homepages/praxisservice/',
               nil, nil, SW_NORMAL);
end;

procedure TForm1.TabsPositionClick(Sender: TObject);
begin
  with ExtPageControl1 do begin
    LockWindowUpdate(Handle);
    Case TabsPosition.ItemIndex Of
      0: TabPosition:= tabPosTop;
      1: TabPosition:= tabPosLeft;
      2: TabPosition:= tabPosRight;
      3: TabPosition:= tabPosBottom;
    End;
    RadioGroupTabStyle.Enabled:= TabPosition = tabPosTop;
    if not RadioGroupTabStyle.Enabled then
      RadioGroupTabStyle.ItemIndex:= 0;
    LockWindowUpdate(0);
  end;
end;

procedure TForm1.ButtonColorFormClick(Sender: TObject);
begin
  with TColorDialog.Create(Application) do try
    Color:= Form1.Color;
    if Execute then Form1.Color:= Color;
  finally
    Free;
  end;
end;

procedure TForm1.ButtonColorATabClick(Sender: TObject);
begin
  with TColorDialog.Create(Application) do try
    Color:= ExtPageControl1.TabActiveColor;
    if Execute then begin
      ExtPageControl1.TabActiveColor:= Color;
      CheckBoxColorTabs.Checked:= False;
    end;
  finally
    Free;
  end;
end;

procedure TForm1.ButtonColorITabClick(Sender: TObject);
begin
  with TColorDialog.Create(Application) do try
    Color:= ExtPageControl1.TabInActiveColor;
    if Execute then begin
      ExtPageControl1.TabInActiveColor:= Color;
      CheckBoxColorTabs.Checked:= False;
    end;
  finally
    Free;
  end;
end;

procedure TForm1.ButtonColorSheetClick(Sender: TObject);
begin
  with TColorDialog.Create(Application) do try
    Color:= ExtPageControl1.Color;
    if Execute then ExtPageControl1.Color:= Color;
  finally
    Free;
  end;
end;

procedure TForm1.ButtonFontATabClick(Sender: TObject);
begin
  with TFontDialog.Create(Application) do try
    Font:= ExtPageControl1.TabActiveFont;
    if Execute then ExtPageControl1.TabActiveFont:= Font;
  finally
    Free;
  end;
end;

procedure TForm1.ButtonFontITabClick(Sender: TObject);
begin
  with TFontDialog.Create(Application) do try
    Font:= ExtPageControl1.TabInActiveFont;
    if Execute then ExtPageControl1.TabInActiveFont:= Font;
  finally
    Free;
  end;
end;

procedure TForm1.CheckBoxTabHintsClick(Sender: TObject);
begin
  ExtPageControl1.ShowHint:= CheckBoxTabHints.Checked;
end;

procedure TForm1.CheckBoxWordWrapClick(Sender: TObject);
begin
  with ExtPageControl1 do
    if CheckBoxWordWrap.Checked then begin
      TabHeight:= TabHeight + 14;
      TabWordWrap:= True;
      Page1.Caption:= 'This is'#10'Page &1';
      Page2.Caption:= 'This is'#10'Page &2';
    end else begin
      TabHeight:= TabHeight - 14;
      TabWordWrap:= False;
      Page1.Caption:= 'Page &1';
      Page2.Caption:= 'Page &2';
    end;
end;

procedure TForm1.CheckBoxDisableTabClick(Sender: TObject);
begin
  with ExtPageControl1 do
    if CheckBoxDisableTab.Checked then begin
      Page2.Enabled:= False;
      Invalidate;
    end else begin
      Page2.Enabled:= True;
      Invalidate;
    end;
end;

procedure TForm1.CheckBoxColorTabsClick(Sender: TObject);
begin
  if CheckBoxColorTabs.Checked then
    ExtPageControl1.OnDrawTab:= DrawColoredTab
  else
    ExtPageControl1.OnDrawTab:= nil;
  ExtPageControl1.Invalidate;
end;

procedure TForm1.DrawColoredTab(Control: TWinControl;
  Index: Integer; ActiveTab: Boolean; const RectFg, RectBg: TRect;
  State: TOwnerDrawState);
begin
  with TExtPageControl(Control) do begin
    Case Index Of
      0: Canvas.Brush.Color:= RGB(192, 220, 192);  // color of Tab 1
      1: Canvas.Brush.Color:= clYellow;            // color of Tab 2
      2: Canvas.Brush.Color:= RGB(166, 202, 240);  // color of Tab 3
    End;
    Canvas.FillRect(RectBg);
    DefaultDrawTab(Index, RectFg, State);
  end;
end;

procedure TForm1.CheckBoxColorPagesClick(Sender: TObject);
begin
  if CheckBoxColorPages.Checked then begin
    ExtPageControl1.OnChange:= ChangeColored;
    ChangeColored(ExtPageControl1);
  end else begin
    ExtPageControl1.OnChange:= nil;
    ExtPageControl1.Color:= clBtnFace;
  end;
end;

procedure TForm1.ChangeColored(Sender: TObject);
// change the color of the TabSheet while switching
begin
  with TExtPageControl(Sender) do
    Case ActivePage.PageIndex Of
      0: Color:= RGB(192, 220, 192);  // color of Page 1
      1: Color:= clYellow;            // color of Page 2
      2: Color:= RGB(166, 202, 240);  // color of Page 3
    End;
end;

procedure TForm1.GlyphsPositionClick(Sender: TObject);
begin
  with ExtPageControl1 do
    Case GlyphsPosition.ItemIndex Of
      0: begin
        TabGlyphs.Position:= glPosTop;
        TabGlyphs.Spacing:= 0;
        TabHeight:= TabHeight + 10;
      end;
      1: begin
        TabGlyphs.Position:= glPosLeft;
        TabGlyphs.Spacing:= 5;
        TabHeight:= TabHeight - 10;
      end;
    End;
end;

procedure TForm1.RadioGroupTabStyleClick(Sender: TObject);
begin
  Case TRadioGroup(Sender).ItemIndex Of
    0: ExtPageControl1.TabStyle:= tabStDefault;
    1: ExtPageControl1.TabStyle:= tabStButton;
  End;
end;

procedure TForm1.CheckBoxDisableTab2Click(Sender: TObject);
begin
  ExtTabControl1.TabEnabled[1]:= not CheckBoxDisableTab2.Checked;
end;

function TForm1.ColorFromIndex(Index: Integer): TColor;
begin
  Case Index Of
    0: Result:= clWhite;    1: Result:= clBlack;
    2: Result:= clSilver;   3: Result:= clGray;
    4: Result:= clRed;      5: Result:= clMaroon;
    6: Result:= clYellow;   7: Result:= clOlive;
    8: Result:= clLime;     9: Result:= clGreen;
   10: Result:= clAqua;    11: Result:= clTeal;
   12: Result:= clBlue;    13: Result:= clNavy;
   14: Result:= clFuchsia; 15: Result:= clPurple;
   16: Result:= RGB(192, 220, 192);
   17: Result:= RGB(166, 202, 240);
   18: Result:= RGB(255, 251, 240);
   19: Result:= RGB(160, 160, 164);
  Else
    Result:= clBtnFace;
  End;
end;

procedure TForm1.ExtTabControl2DrawTab(Control: TWinControl;
  Index: Integer; ActiveTab: Boolean; const RectFg, RectBg: TRect;
  State: TOwnerDrawState);
begin
  with TExtTabControl(Control) do begin
    Canvas.Brush.Color:= ColorFromIndex(Index);
    Canvas.FillRect(RectBg);
  end;
end;

procedure TForm1.ExtTabControl2Change(Sender: TObject);
begin
  PanelTabControl2.Color:= ColorFromIndex(ExtTabControl2.TabIndex);
end;

end.